home *** CD-ROM | disk | FTP | other *** search
/ Aminet 37 / Aminet 37 (2000)(Schatztruhe)[!][Jun 2000].iso / Aminet / comm / www / WebYAM.lha / yam.rexx < prev   
OS/2 REXX Batch file  |  2000-04-04  |  22KB  |  665 lines
  1. /*
  2. ** $VER: WebYAM 1.0 (4.4.2000)
  3. ** © 2000 by Jacob Laursen <jlaur@mail1.stofanet.dk>
  4. **
  5. ** Webbrowse YAM folders
  6. **
  7. ** For "quoted printable" -> "8bit" conversion, please download
  8. ** comm/mail/YToolsNG.lha from Aminet and copy the file 'YTCunmime'
  9. ** to the YAM: directory, or correct the path below.
  10. **
  11. ** Version 1.0 - Initial release.
  12. **
  13. ** TODO:
  14. ** - User-configurable settings
  15. ** - Process mail to read (create links etc.)
  16. */
  17.  
  18. options results
  19. options failat 11
  20.  
  21. /* YAM executable path */
  22. YAMPath = 'YAM:YAM'
  23.  
  24. /* YAM folder file */
  25. Cfg.YAMFolders = 'YAM:.folders'
  26.  
  27. /* YTCunmime executable path */
  28. Cfg.UMPath = 'YAM:YTCunmime'
  29.  
  30. /* Misc. appearance options */
  31. Cfg.MsgsPerPage  = 25 /* Number of messages per page            */
  32. Cfg.NumColsQuick =  4 /* Number of columns in quick folder list */
  33. Cfg.NumColsFull  =  2 /* Number of columns in full folder list  */
  34.  
  35. /* Color settings - only RRGGBB values accepted */
  36. Cfg.FldrHdrColor = '333366'
  37. Cfg.BgColor      = 'eeeecc'
  38.  
  39. /* No user-serviceable parts below... */
  40.  
  41.   say 'Content-type: text/html'; say ''
  42.  
  43.   say '<HTML>'; say ''
  44.   say '  <HEAD>'
  45.   say '    <TITLE>Yet Another Mailer - Web Interface</TITLE>'
  46.  
  47.   if ~show('P','YAM') then do
  48.     say '    <META HTTP-EQUIV="Refresh" CONTENT=30>'
  49.     say '  </HEAD>'; say ''
  50.     say '  <BODY BGCOLOR="#ffffff" TEXT="#000000">'
  51.     say '    <P>Please wait, loading YAM...</P>'
  52.     say '  </BODY>'
  53.     say '</HTML>'
  54.     address command 'run <>nil: ' || YAMPath || ' HIDE'
  55.     exit
  56.   end
  57.  
  58.   say '  </HEAD>'; say ''
  59.   say '  <BODY BGCOLOR="#ffffff" TEXT="#000000">'
  60.  
  61.   if ~show('L','rexxdossupport.library') then if ~addlib('rexxdossupport.library',0,-30,0) then do
  62.     say '    <P>Error: rexxdossupport.library couldn''t be opened!</P>'
  63.     say '  </BODY>'
  64.     say '</HTML>'
  65.     exit 10
  66.   end
  67.  
  68.   'getvar QUERY_STRING'; query = result
  69.   call ParseArgs(query)
  70.  
  71.   address 'YAM'
  72.  
  73.   if Arg.Check = 1 then call GetMail
  74.   if Arg.Help  = 1 then call Help
  75.   else if Arg.Compose = 1 then call ComposeMail
  76.   else if Arg.Send = 1 then call SendMail
  77.   else if Arg.List = 1 then call ListFolders
  78.   else if Arg.Folder > -1 then do
  79.     if Arg.Message > -1 then do
  80.       if Arg.Move = 1 then call MoveMail
  81.       else if Arg.Delete = 1 then call DeleteMail
  82.       else call ReadMessage(Arg.Folder, Arg.Message)
  83.     end
  84.     else do
  85.       if Arg.Move = 1 then call MoveMails(Arg.Folder, Arg.Page)
  86.       else if Arg.Delete = 1 then call DeleteMails(Arg.Folder, Arg.Page)
  87.       else call ListFolder(Arg.Folder, Arg.Page)
  88.     end
  89.   end
  90.   else call ListDeadFolders
  91.  
  92.   say '  </BODY>'
  93.   say '</HTML>'
  94.  
  95. exit
  96.  
  97. ParseArgs: PROCEDURE EXPOSE Arg.
  98. parse arg string
  99.  
  100.   Arg.List       =  0
  101.   Arg.Check      =  0
  102.   Arg.Help       =  0
  103.   Arg.Compose    =  0
  104.   Arg.Send       =  0
  105.   Arg.Signature  =  0
  106.   Arg.Keep       =  1
  107.   Arg.Folder     = -1
  108.   Arg.DestFolder = -1
  109.   Arg.Message    = -1
  110.   Arg.Page       =  1
  111.  
  112.   Arg.Delete     = 0
  113.   Arg.Move       = 0
  114.   Arg.Msgs.COUNT = 0
  115.  
  116.   query = translate(string, ' ', '&')
  117.   do loop = 1 to words(query)
  118.     arg = word(query,loop)
  119.     if index(arg,'=') > 1 then do
  120.       cmd = left(arg,index(arg,'=')-1)
  121.       parse var arg cmd'='value
  122.       cmd = upper(cmd)
  123.       if cmd = 'FOLDER'     then Arg.Folder     = value
  124.       if cmd = 'DESTFOLDER' then Arg.DestFolder = value
  125.       if cmd = 'MESSAGE'    then Arg.Message    = value
  126.       if cmd = 'PAGE'       then Arg.Page       = value
  127.       if cmd = 'OPTION' & upper(value) = 'DELETE'  then Arg.Delete = 1
  128.       if cmd = 'OPTION' & upper(value) = 'MOVE+TO' then Arg.Move   = 1
  129.       if cmd = 'SEND'   & upper(value) = 'SEND'    then Arg.Send   = 1
  130.       if cmd = 'TO'      then Arg.Recipient = Convert(value)
  131.       if cmd = 'CC'      then Arg.Cc        = Convert(value)
  132.       if cmd = 'BCC'     then Arg.Bcc       = Convert(value)
  133.       if cmd = 'SUBJECT' then Arg.Subject   = Convert(value)
  134.       if cmd = 'BODY'    then Arg.Body      = Convert(value)
  135.       if cmd = 'SIGNATURE' & upper(value) = 'ON' then Arg.Signature = 1
  136.       if cmd = 'KEEP' & upper(value) = 'OFF' then Arg.Keep = 0
  137.       if left(cmd,8) = 'MESSAGE.' then do
  138.         parse var arg dummy'.'num'='val
  139.         current = Arg.Msgs.COUNT
  140.         if upper(val) = 'ON' then do
  141.           Arg.Msgs.current = num
  142.           Arg.Msgs.COUNT = current + 1
  143.         end
  144.       end
  145.     end
  146.     else do
  147.       arg = upper(arg)
  148.       if arg = 'LIST'    then Arg.List    = 1
  149.       if arg = 'CHECK'   then Arg.Check   = 1
  150.       if arg = 'HELP'    then Arg.Help    = 1
  151.       if arg = 'COMPOSE' then Arg.Compose = 1
  152.     end
  153.  
  154.   end
  155.  
  156. return
  157.  
  158. ParseFolders: PROCEDURE EXPOSE Cfg.
  159.  
  160.   if ~exists(Cfg.YAMFolders) then return
  161.   call open(fh, Cfg.YAMFolders, 'R')
  162.  
  163.   Cfg.FolderName.COUNT = 0
  164.   do while ~eof(fh)
  165.     line = readln(fh)
  166.     if word(line, 1) = '@FOLDER' then do
  167.       current = Cfg.FolderName.COUNT
  168.       Cfg.FolderName.current = 'F:'right(line,length(line)-8)
  169.       Cfg.FolderName.COUNT = current + 1
  170.     end
  171.     else if word(line, 1) = '@SEPARATOR' then do
  172.       current = Cfg.FolderName.COUNT
  173.       if length(line) > 11 then Cfg.FolderName.current = 'S:'right(line,length(line)-11)
  174.       else Cfg.FolderName.current = 'S:'
  175.       Cfg.FolderName.COUNT = current + 1
  176.     end
  177.   end
  178.  
  179.   call close(fh)
  180.  
  181. return
  182.  
  183. GotoMail: PROCEDURE
  184. parse arg num
  185.  
  186.   SETMAIL num
  187.   if RC ~= 10 then return 0
  188.   else say '    <P>This mail does not exist -- please update message list.</P>'
  189.  
  190. return 10
  191.  
  192. GotoFolder: PROCEDURE
  193. parse arg num
  194.  
  195.   SETFOLDER num
  196.   if RC ~= 10 then return 0
  197.   else say '    <P>This folder does not exist -- please update folder list.</P>'
  198.  
  199. return 10
  200.  
  201. ListFolders: PROCEDURE EXPOSE Cfg.
  202.  
  203.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  204.   say '      <TR ALIGN="center">'
  205.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  206.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?list&check"><B>Get mail</B></A></TD>'
  207.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  208.   say '        <TD BGCOLOR="#cccc99"><A HREF="yam.rexx?list"><B>Folders (full)</B></A></TD>'
  209.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?help"><B>Help</B></A></TD>'
  210.   say '      </TR>'
  211.   say '    </TABLE>'
  212.  
  213.   say '    <TABLE BORDER=0 CELLSPACING=1 WIDTH="100%">'
  214.   say '      <TR BGCOLOR="#'Cfg.FldrHdrColor'">'
  215.   say '        <TD ALIGN="left"><FONT COLOR="#ffffff"><B>No.</B></FONT></TD>'
  216.   say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Folder</B></FONT></TD>'
  217.   say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Total</B></FONT></TD>'
  218.   say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Unread</B></FONT></TD>'
  219.   say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>New</B></FONT></TD>'
  220.   say '      </TR>'
  221.  
  222.   i = 0
  223.   call GoBusy
  224.   do forever
  225.     SETFOLDER i
  226.     if RC = 10 then do
  227.       SETFOLDER i+1
  228.       if RC = 10 then leave
  229.       /* Workaround for separator lines. Two in a row still breaks this routine */
  230.       i = i + 1
  231.       iterate
  232.     end
  233.     FOLDERINFO STEM cfi.
  234.     say '      <TR BGCOLOR="#'Cfg.BgColor'">'
  235.     say '        <TD ALIGN="left">'cfi.NUMBER'</TD>'
  236.     say '        <TD ALIGN="left"><A HREF="yam.rexx?Folder='cfi.NUMBER'">'cfi.NAME'</A></TD>'
  237.     say '        <TD ALIGN="right">'cfi.TOTAL'</TD>'
  238.     say '        <TD ALIGN="right">'cfi.UNREAD'</TD>'
  239.     say '        <TD ALIGN="right">'cfi.NEW'</TD>'
  240.     say '      </TR>'
  241.     i = i + 1
  242.   end
  243.   APPNOBUSY
  244.  
  245.   say '    </TABLE>'; say
  246.  
  247. return
  248.  
  249. ListDeadFolders: PROCEDURE EXPOSE Cfg.
  250.  
  251.   if ~exists(Cfg.YAMFolders) then do
  252.     call ListFolders
  253.     return
  254.   end
  255.  
  256.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  257.   say '      <TR ALIGN="center">'
  258.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  259.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?check"><B>Get mail</B></A></TD>'
  260.   say '        <TD BGCOLOR="#cccc99"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  261.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?list"><B>Folders (full)</B></A></TD>'
  262.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?help"><B>Help</B></A></TD>'
  263.   say '      </TR>'
  264.   say '    </TABLE>'
  265.  
  266.   call ParseFolders
  267.  
  268.   say '    <TABLE BORDER=0 CELLSPACING=1 WIDTH="100%">'
  269.   say '      <TR BGCOLOR="#'Cfg.FldrHdrColor'">'
  270.   do loop = 0 to Cfg.NumColsQuick-1
  271.     say '        <TD><FONT COLOR="#ffffff"><B>No.</B></FONT></TD>'
  272.     say '        <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Folder</B></FONT></TD>'
  273.   end
  274.   say '      </TR>'
  275.  
  276.   step = Cfg.FolderName.COUNT/Cfg.NumColsQuick
  277.   if trunc(step) ~= step then step = trunc(step)+1
  278.  
  279.   do mainloop = 0 to step-1
  280.     say '      <TR BGCOLOR="#'Cfg.BgColor'">'
  281.     do loop = 0 to Cfg.NumColsQuick-1
  282.       current = mainloop+loop*step
  283.       if current > Cfg.FolderName.COUNT-1 then leave
  284.       if left(cfg.FolderName.current, 2) = 'F:' then do
  285.         say '        <TD>'current'</TD>'
  286.         say '        <TD><A HREF="yam.rexx?Folder='current'">'right(cfg.FolderName.current, length(cfg.FolderName.current)-2)'</A></TD>'
  287.       end
  288.     end
  289.     say '      </TR>'
  290.   end
  291.  
  292.   say '    </TABLE>'; say
  293.  
  294. return
  295.  
  296. DeleteMail: PROCEDURE EXPOSE Arg. Cfg.
  297.  
  298.   Arg.Msgs.COUNT = 1
  299.   Arg.Msgs.0 = Arg.Message
  300.   call DeleteMails(Arg.Folder, Arg.Page)
  301.  
  302. return
  303.  
  304. DeleteMails: PROCEDURE EXPOSE Arg. Cfg.
  305. parse arg folder, page
  306.  
  307.   call GoBusy
  308.   RC = GotoFolder(folder)
  309.   if RC = 10 then do
  310.     APPNOBUSY
  311.     return
  312.   end
  313.  
  314.   do loop=Arg.Msgs.COUNT-1 to 0 by -1
  315.     RC = GotoMail(Arg.Msgs.loop)
  316.     if RC = 10 then leave
  317.     MAILDELETE 'FORCE'
  318.   end
  319.   APPNOBUSY
  320.  
  321.   call ListFolder(folder, page)
  322.  
  323. return
  324.  
  325. MoveMail: PROCEDURE EXPOSE Arg. Cfg.
  326.  
  327.   Arg.Msgs.COUNT = 1
  328.   Arg.Msgs.0 = Arg.Message
  329.   call MoveMails(Arg.Folder, Arg.Page)
  330.  
  331. return
  332.  
  333. MoveMails: PROCEDURE EXPOSE Arg. Cfg.
  334. parse arg folder, page
  335.  
  336.   call GoBusy
  337.   RC = GotoFolder(folder)
  338.   if RC = 10 then do
  339.     APPNOBUSY
  340.     return
  341.   end
  342.  
  343.   do loop=Arg.Msgs.COUNT-1 to 0 by -1
  344.     RC = GotoMail(Arg.Msgs.loop)
  345.     if RC = 10 then leave
  346.     MAILMOVE Arg.DestFolder
  347.   end
  348.   APPNOBUSY
  349.  
  350.   call ListFolder(folder, page)
  351.  
  352. return
  353.  
  354. ListFolder: PROCEDURE EXPOSE Cfg.
  355. parse arg folder, page
  356.  
  357.   call ParseFolders
  358.   call GoBusy
  359.  
  360.   RC = GotoFolder(folder)
  361.   if RC = 10 then do
  362.     APPNOBUSY
  363.     return
  364.   end
  365.  
  366.   FOLDERINFO STEM fi.
  367.  
  368.   start = Cfg.MsgsPerPage * (page-1)
  369.   end   = Cfg.MsgsPerPage * page
  370.   if end >= fi.TOTAL then end = fi.TOTAL
  371.   pages = trunc((fi.TOTAL-1)/Cfg.MsgsPerPage)+1
  372.  
  373.   say '    <FORM NAME="WebYAM" ACTION="yam.rexx">'
  374.   say '      <INPUT TYPE="hidden" NAME="Folder" VALUE="'folder'">'
  375.   say '      <INPUT TYPE="hidden" NAME="Page" VALUE="'page'">'
  376.  
  377.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  378.   say '        <TR>'
  379.   say '          <TD COLSPAN=1 ALIGN="left"><FONT SIZE=+2><B>Folder: 'right(Cfg.FolderName.folder, length(Cfg.FolderName.folder)-2)'</B></FONT></TD>'
  380.   pageinfo = '        <TD COLSPAN=4 ALIGN="right">Page 'page' of 'pages' ['
  381.   do loop = 1 to pages
  382.     if loop = page then pageinfo = pageinfo' 'loop
  383.     else pageinfo = pageinfo' <A HREF="yam.rexx?Folder='folder'&Page='loop'">'loop'</A>'
  384.   end
  385.   say pageinfo' ]</TD>'
  386.  
  387.   say '        <TR ALIGN="center">'
  388.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  389.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx?Folder='folder'&check"><B>Get mail</B></A></TD>'
  390.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  391.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx?list"><B>Folders (full)</B></A></TD>'
  392.   say '          <TD BGCOLOR="#336699"><A HREF="yam.rexx?help"><B>Help</B></A></TD>'
  393.   say '        </TR>'
  394.   say '      </TABLE>'
  395.  
  396.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  397.   say '        <TR BGCOLOR="#'Cfg.FldrHdrColor'">'
  398.   say '          <TD><IMG SRC="pics/newmail.gif" WIDTH=11 HEIGHT=11 ALT="New" HSPACE=5></TD>'
  399.   say '          <TD HEIGHT=23> </TD>'
  400.   say '          <TD ALIGN="left"> <FONT COLOR="#ffffff"><B>No.</B></FONT></TD>'
  401.   say '          <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Name</B></FONT></TD>'
  402.   say '          <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Subject</B></FONT></TD>'
  403.   say '          <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Date</B></FONT></TD>'
  404.   say '          <TD ALIGN="center"><FONT COLOR="#ffffff"><B>Size</B></FONT></TD>'
  405.   say '          <TD ALIGN="right"><FONT COLOR="#ffffff"><B>Flags</B></FONT> </TD>'
  406.   say '        </TR>'
  407.  
  408.   do loop = start to end-1
  409.     SETMAIL loop
  410.     MAILINFO STEM sel.
  411.     if index(sel.FROM,'<') ~= 0 then email = left(sel.FROM,index(sel.FROM,'<')-2)
  412.     else email = sel.FROM
  413.     say '        <TR BGCOLOR="#'Cfg.BgColor'">'
  414.  
  415.     if sel.STATUS = 'U' | sel.STATUS = 'N' then say '         <TD><IMG SRC="pics/newmail.gif" WIDTH=11 HEIGHT=11 ALT="New" HSPACE=5></TD>'
  416.     else say '         <TD> </TD>'
  417.  
  418.     say '          <TD><INPUT TYPE="checkbox" NAME="Message.'loop'"></TD>'
  419.  
  420.     say '          <TD ALIGN="left" NOWRAP> 'sel.INDEX'</TD>'
  421.     estr = '          <TD ALIGN="left" NOWRAP> '
  422.     if left(sel.FLAGS,1) = 'M' then estr = estr'<IMG SRC="pics/status_group.gif" WIDTH=19 HEIGHT=9 ALT="M"> '
  423.     estr = estr'<A HREF="yam.rexx?Folder='folder'&Message='sel.INDEX'">'email'</A></TD>'
  424.     say estr
  425.     say '          <TD ALIGN="left" NOWRAP> 'sel.SUBJECT'</TD>'
  426.     say '          <TD ALIGN="left" NOWRAP> 'sel.DATE'</TD>'
  427.     say '          <TD ALIGN="right" NOWRAP>'sel.SIZE' </TD>'
  428.  
  429.     imgstat = '          <TD ALIGN="right" NOWRAP>'
  430.     if substr(sel.FLAGS,2,1) = 'A' then imgstat = imgstat'<IMG SRC="pics/status_attach.gif" WIDTH=9 HEIGHT=10 ALT="A"> '
  431.     if substr(sel.FLAGS,3,1) = 'R' then imgstat = imgstat'<IMG SRC="pics/status_report.gif" WIDTH=6 HEIGHT=10 ALT="R"> '
  432.     if substr(sel.FLAGS,4,1) = 'C' then imgstat = imgstat'<IMG SRC="pics/status_crypt.gif" WIDTH=6 HEIGHT=9 ALT="C"> '
  433.     if substr(sel.FLAGS,5,1) = 'S' then imgstat = imgstat'<IMG SRC="pics/status_signed.gif" WIDTH=6 HEIGHT=9 ALT="S"> '
  434.     if sel.STATUS = 'O' then imgstat = imgstat'<IMG SRC="pics/status_old.gif" WIDTH=25 HEIGHT=10 ALT="O">'
  435.     else if sel.STATUS = 'N' then imgstat = imgstat'<IMG SRC="pics/status_new.gif" WIDTH=25 HEIGHT=10 ALT="N">'
  436.     else if sel.STATUS = 'R' then imgstat = imgstat'<IMG SRC="pics/status_reply.gif" WIDTH=25 HEIGHT=10 ALT="R">'
  437.     else if sel.STATUS = 'U' then imgstat = imgstat'<IMG SRC="pics/status_unread.gif" WIDTH=25 HEIGHT=10 ALT="U">'
  438.     else if sel.STATUS = 'F' then imgstat = imgstat'<IMG SRC="pics/status_forward.gif" WIDTH=25 HEIGHT=10 ALT="F">'
  439.     else if sel.STATUS = 'S' then imgstat = imgstat'<IMG SRC="pics/status_sent.gif" WIDTH=25 HEIGHT=10 ALT="S">'
  440.     else if sel.STATUS = 'W' then imgstat = imgstat'<IMG SRC="pics/status_waitsend.gif" WIDTH=25 HEIGHT=10 ALT="W">'
  441.     else if sel.STATUS = 'H' then imgstat = imgstat'<IMG SRC="pics/status_hold.gif" WIDTH=25 HEIGHT=10 ALT="H">'
  442.     else if sel.STATUS = 'E' then imgstat = imgstat'<IMG SRC="pics/status_error.gif" WIDTH=25 HEIGHT=10 ALT="E">'
  443.     say imgstat' </TD>'
  444.     say '        </TR>'
  445.   end
  446.  
  447.   APPNOBUSY
  448.  
  449.   say '        <TR><TD HEIGHT=12></TD></TR>'
  450.   say '        <TR>'
  451.   temp = '          <TD VALIGN="top" ALIGN="right" COLSPAN=8> [ '
  452.   if page = 1 then temp = temp'Prev Page'
  453.   else temp = temp'<A HREF="yam.rexx?Folder='folder'&Page='page-1'">Prev Page</A>'
  454.   temp = temp' | '
  455.   if page = pages then temp = temp'Next Page'
  456.   else temp = temp'<A HREF="yam.rexx?Folder='folder'&Page='page+1'">Next Page</A>'
  457.   say temp' ]</TD>'
  458.   say '        </TR>'
  459.   say '      </TABLE>'; say
  460.  
  461.   call MakeMoveTo(folder)
  462.  
  463.   say '    </FORM>'
  464.  
  465. return
  466.  
  467. ReadMessage: PROCEDURE EXPOSE Cfg.
  468. parse arg folder, message
  469.  
  470.   call GoBusy
  471.   RC = GotoFolder(folder)
  472.   if RC = 10 then do
  473.     APPNOBUSY
  474.     return
  475.   end
  476.  
  477.   RC = GotoMail(message)
  478.   if RC = 10 then do
  479.     APPNOBUSY
  480.     return
  481.   end
  482.  
  483.   call ParseFolders
  484.   FOLDERINFO STEM cfi.
  485.  
  486.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  487.   say '      <TR ALIGN="center">'
  488.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  489.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Folder='folder'&Message='message'&Check"><B>Get mail</B></A></TD>'
  490.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Folder='folder'"><B>'cfi.NAME'</B></A></TD>'
  491.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  492.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  493.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  494.   say '      </TR>'
  495.   say '    </TABLE>'
  496.  
  497.   MAILEXPORT 'T:YAM-TextMode.tmp'
  498.   if exists(Cfg.UMPath) = 1 then address command Cfg.UMPath || ' MAIL=T:YAM-TextMode.tmp'
  499.   say '    <PRE>'
  500.   address command 'Type T:YAM-TextMode.tmp'
  501.   say '    </PRE>'
  502.   address command 'Delete >NIL: T:YAM-TextMode.tmp'
  503.  
  504.   MAILINFO STEM sel.
  505.   if sel.STATUS = 'N' | sel.STATUS = 'U' then MAILSTATUS 'O'
  506.  
  507.   APPNOBUSY
  508.   say '    <FORM NAME="WebYAM" ACTION="yam.rexx">'
  509.   say '      <INPUT TYPE="hidden" NAME="Folder" VALUE="'folder'">'
  510.   say '      <INPUT TYPE="hidden" NAME="Message" VALUE="'message'">'
  511.   call ParseFolders
  512.   call MakeMoveTo(folder)
  513.   say '    </FORM'
  514.  
  515. return
  516.  
  517. GetMail: PROCEDURE
  518.  
  519.   MAILCHECK
  520.  
  521. return
  522.  
  523. ComposeMail: PROCEDURE
  524.  
  525.   say '    <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH="100%">'
  526.   say '      <TR ALIGN="center">'
  527.   say '        <TD BGCOLOR="#cccc99"><A HREF="yam.rexx?Compose"><B>Compose</B></A></TD>'
  528.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Compose&Check"><B>Get mail</B></A></TD>'
  529.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx"><B>Folders</B></A></TD>'
  530.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?List"><B>Folders (full)</B></A></TD>'
  531.   say '        <TD BGCOLOR="#336699"><A HREF="yam.rexx?Help"><B>Help</B></A></TD>'
  532.   say '      </TR>'
  533.   say '    </TABLE>'
  534.  
  535.   say '    <FORM NAME="composeform" ACTION="yam.rexx">'
  536.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>'
  537.   say '        <TR VALIGN="top">'
  538.   say '          <TD COLSPAN=2 ALIGN="center">'
  539.   say '            <INPUT TYPE="submit" NAME="Send" VALUE="Send">'
  540.   say '            <INPUT TYPE="submit" NAME="Cancel" VALUE="Cancel">'
  541.   say '          </TD>'
  542.   say '        </TR>'
  543.   say '        <TR>'
  544.   say '          <TD ALIGN="right" NOWRAP><B>To:</B></TD>'
  545.   say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="To" VALUE="" SIZE=65 MAXLENGTH=1000</TD>'
  546.   say '        </TR>'
  547.   say '        <TR>'
  548.   say '          <TD ALIGN="right" NOWRAP><B>Cc:</B></TD>'
  549.   say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="Cc" VALUE="" SIZE=65 MAXLENGTH=1000</TD>'
  550.   say '        </TR>'
  551.   say '        <TR>'
  552.   say '          <TD ALIGN="right" NOWRAP><B>Bcc:</B></TD>'
  553.   say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="Bcc" VALUE="" SIZE=65 MAXLENGTH=1000</TD>'
  554.   say '        </TR>'
  555.   say '        <TR>'
  556.   say '          <TD ALIGN="right" NOWRAP><B>Subject:</B></TD>'
  557.   say '          <TD ALIGN="left"><INPUT TYPE="text" NAME="Subject" VALUE="" SIZE=65 MAXLENGTH=80</TD>'
  558.   say '        </TR>'
  559.   say '        <TR>'
  560.   say '          <TD></TD>'
  561.   say '          <TD HEIGHT=30 VALIGN="middle">'
  562.   say '            <INPUT TYPE="checkbox" NAME="Signature" VALUE="on">Add signature'
  563.   say '            <INPUT TYPE="checkbox" NAME="Keep" VALUE="off">Delete when sent'
  564.   say '          </TD>'
  565.   say '        </TR>'
  566.   say '      </TABLE>'
  567.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>'
  568.   say '        <TR>'
  569.   say '          <TD ALIGN="center">'
  570.   say '            <TEXTAREA NAME="Body" ROWS=30 COLS=74 WRAP="soft"></TEXTAREA>'
  571.   say '          </TD>'
  572.   say '        </TR>'
  573.   say '      </TABLE>'
  574.   say '    </FORM>'
  575.  
  576. return
  577.  
  578. SendMail: PROCEDURE EXPOSE Arg.
  579.  
  580. /*
  581.   say 'To: 'Arg.Recipient'<BR>'
  582.   say 'Subject: 'Arg.Subject'<BR>'
  583.   say 'Body: 'Arg.Body'<BR>'
  584. */
  585.  
  586.   call open(fh, 'T:WebYAM-write.tmp', 'W')
  587.   call writeln(fh, Arg.body)
  588.   call close(fh)
  589.  
  590.   call GoBusy
  591.  
  592.   MAILWRITE
  593.   WRITETO '"'Arg.Recipient'"'
  594.   if Arg.Cc ~= 'ARG.CC' then WRITECC '"'Arg.Cc'"'
  595.   if Arg.Bcc ~= 'ARG.BCC' then WRITEBCC '"'Arg.Bcc'"'
  596.   WRITESUBJECT '"'Arg.Subject'"'
  597.   WRITELETTER 'T:WebYAM-write.tmp'
  598.   opts = ''
  599.   if Arg.Signature = 0 then opts = 'SIG=0'
  600.   if Arg.Keep = 0 then opts = opts' DELETE'
  601.   if opts ~= '' then WRITEOPTIONS opts
  602.   WRITESEND
  603.  
  604.   APPNOBUSY
  605.   address command 'Delete >NIL: T:WebYAM-write.tmp'
  606.  
  607.   say '    <P>Your mail was succesfully sent.</P>'
  608.  
  609. return
  610.  
  611. Help: PROCEDURE
  612.  
  613.   say '    <H1>WebYAM 1.0 by Jacob Laursen</H1>'; say
  614.   say '    <P>Browse your YAM folders through the World Wide Web.</P>'
  615.   say '    <P>'
  616.   say '      Author''s e-mail address: <A HREF="mailto:laursen@myself.com">laursen@myself.com</A><BR>'
  617.   say '      WebYAM homepage: <A HREF="http://home.worldonline.dk/~jlaur/amiga/webyam/">http://home.worldonline.dk/~jlaur/amiga/webyam/</A><BR>'
  618.   say '      Status icons by Ash Thomas'
  619.   say '    </P>'
  620.  
  621. return
  622.  
  623. Convert: PROCEDURE
  624. parse arg dummy
  625.  
  626.   dummy = translate(dummy, ' ', '+')
  627.   do until pos=0
  628.     pos=index(dummy,'%')
  629.     if pos>0 then do
  630.       hex=substr(dummy,pos+1,2)
  631.       char=x2c(hex)
  632.       if pos=1 then dummy=char||substr(dummy,pos+3)
  633.       if pos>1 & pos<length(dummy)-2 then dummy=left(dummy,pos-1)||char||substr(dummy,pos+3)
  634.       if pos=length(dummy)-2 then dummy=left(dummy,pos-1)||char
  635.     end
  636.   end
  637.  
  638. return dummy
  639.  
  640. GoBusy: PROCEDURE
  641.  
  642.   APPBUSY 'TEXT="WebYAM is working, please wait..."'
  643.  
  644. return
  645.  
  646. MakeMoveTo: PROCEDURE EXPOSE Cfg.
  647. parse arg folder
  648.  
  649.   say '      <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>'
  650.   say '        <TR>'
  651.   say '          <TD ALIGN="center"><INPUT TYPE="submit" NAME="Option" VALUE="Move to"></TD>'
  652.   say '          <TD ALIGN="left" COLSPAN=2><SELECT NAME="DestFolder">'
  653.   do loop = 0 to Cfg.FolderName.COUNT-1
  654.     if loop = folder then iterate
  655.     if left(Cfg.FolderName.loop, 2) = 'F:' then say '            <OPTION VALUE="'loop'">'right(Cfg.FolderName.loop,length(Cfg.FolderName.loop)-2)
  656.   end
  657.   say '          </SELECT></TD>'
  658.   say '        </TR>'
  659.   say '        <TR>'
  660.   say '          <TD ALIGN="center"><INPUT TYPE="submit" NAME="Option" VALUE="Delete"></TD>'
  661.   say '        </TR>'
  662.   say '      </TABLE>'
  663.  
  664. return
  665.